perm filename IODEFS.SAI[4,KMC]1 blob
sn#177271 filedate 1975-09-17 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00003 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 DEFINE TAB="'11", LF="'12", FF="'14", CR="'15", SP="'40",
C00006 00003 INTEGER PROC ROUND(VALUE REAL R) RETURN(R + .5)
C00009 ENDMK
C⊗;
DEFINE TAB="'11", LF="'12", FF="'14", CR="'15", SP="'40",
ALT="'175", BS="'177", ↓="& CR & LF", ∂="& "" "" &";
DEFINE α="COMMENT", TIL="STEP 1 UNTIL", LN="LENGTH", PROC="PROCEDURE";
INTEGER INCH1,INCH2,OUCH1,OUCH2,CNT,BRK,EOF,FLAG; α INPUT/OUTPUT GLOBALS;
STRING FILE;
DEFINE DSKI="OPEN(INCH←GETCHAN,""DSK"",0,4,0,CNT←200,BRK,EOF)",
DSKO="OPEN(OUCH←GETCHAN,""DSK"",0,0,4,0,0,EOF)",
FILI="LOOKUP(INCH,IFILE,FLAG)",
FILO="ENTER(OUCH,OFILE,FLAG)",
LPTO="OPEN(OUCH←GETCHAN,""LPT"",0,0,2,0,0,EOF←0)",
TTYI="OPEN(INCH←GETCHAN,""TTY"",1,2,0,CNT←200,BRK,EOF)",
TTYO="OPEN(OUCH←GETCHAN,""TTY"",1,0,2,0,0,EOF)";
FORWARD STRING PROC GET_A_STRING(VALUE STRING QUESTION);
PROC FILIN(VALUE STRING IFILE; REFERENCE INTEGER INCH);
BEGIN
DSKI; FILI;
WHILE FLAG DO
BEGIN
LODED(IFILE);
IFILE ← GET_A_STRING("Try again");
FILI;
END;
END;
PROC FINDFIL(VALUE STRING IFILE; REFERENCE INTEGER INCH);
BEGIN DSKI; FILI; END;
PROC FILOUT(VALUE STRING OFILE; REFERENCE INTEGER OUCH);
BEGIN DSKO; FILO; END;
DEFINE BREAK_LINE="SETBREAK(1, LF, CR & FF, ""ISN"")",
BREAK_BLANK="SETBREAK(2, SP, NULL, ""ISN"")",
BREAK_TAB="SETBREAK(3, TAB, NULL, ""ISN"");
SETBREAK(4, NULL, TAB, ""ISN"")",
BREAK_LISP="SETBREAK(5, "")"", NULL, ""IAN"");
SETBREAK(6, "" )"", NULL, ""IRN"")",
BREAK_EXT="SETBREAK(7, "" .["", NULL, ""ISN"")",
BREAK_COMMA="SETBREAK(8, "","", NULL, ""ISN"")";
DEFINE EAT_DIR(TEMP, INCH)="DO TEMP ← INPUT(INCH, 1) UNTIL EQU(TEMP, ""C⊗;"")";
DEFINE IN_LINE="INPUT(INCH1,1)";
PROC OUT_LINE(VALUE STRING LINE); OUT(OUCH1, LINE ↓);
STRING BLANKS; INTEGER I;
STRING PROC LEFTJ(VALUE INTEGER L; VALUE STRING S);
RETURN(IF LN(S)<L THEN S&BLANKS[1 TO L-LN(S)] ELSE S[1 TO L]);
STRING PROC RIGHTJ(VALUE INTEGER L; VALUE STRING S);
RETURN(IF LN(S)<L THEN BLANKS[1 TO L-LN(S)]&S ELSE S[1 TO L]);
STRING PROC CENTER(VALUE INTEGER L; VALUE STRING S);
RETURN(IF LN(S)<L THEN BLANKS[1 TO (L-LN(S))DIV 2]&
S & BLANKS[1 TO (L-LN(S)+1)DIV 2] ELSE S[1 TO L]);
INTEGER PROC ROUND(VALUE REAL R); RETURN(R + .5);
INTEGER PROC GET_AN_INT(VALUE STRING QUESTION);
BEGIN
STRING ANSWER;
OUTSTR(QUESTION ∂ "? ");
ANSWER ← INCHWL;
RETURN(INTSCAN(ANSWER, BRK));
END;
STRING PROC GET_A_STRING(VALUE STRING QUESTION);
BEGIN
OUTSTR(QUESTION ∂ "?" ↓);
RETURN(INCHWL);
END;
α 0 = identical
n = A < B, first difference in position "n"
-n = A > B, first difference in position "n";
INTEGER PROC ALPHA(VALUE STRING A, B);
BEGIN
INTEGER AVAL, BVAL, COUNT;
COUNT ← 1;
WHILE (AVAL ← LOP(A)) = (BVAL ← LOP(B)) DO
IF AVAL = 0 THEN RETURN(0) ELSE COUNT ← COUNT + 1;
RETURN(IF(AVAL < BVAL) THEN COUNT ELSE -COUNT);
END;
STRING PROC CAR(VALUE STRING LINE);
RETURN(SCAN(LINE, 3, BRK));
STRING PROC CDR(VALUE STRING LINE);
BEGIN
STRING TEMP;
TEMP ← SCAN(LINE, 3, BRK);
RETURN(SCAN(LINE, 4, BRK));
END;
INTEGER PROC SCAN_COORDINATE(REFERENCE STRING LINE; VALUE INTEGER NEG, POS);
BEGIN
INTEGER COORD, ORIENT;
COORD ← INTSCAN(LINE, BRK);
ORIENT ← LOP(LINE);
ORIENT ← LOP(LINE);
IF ORIENT ≥ "a" THEN ORIENT ← ORIENT - 32;
IF ORIENT = NEG THEN COORD ← - COORD
ELSE IF ORIENT ≠ POS THEN OUTSTR("Peculiar coordinate:" ∂ LINE ↓);
RETURN(COORD);
END;
INTEGER PROC SCAN_LONG(REFERENCE STRING LINE);
RETURN(SCAN_COORDINATE(LINE, "W", "E"));
INTEGER PROC SCAN_LAT(REFERENCE STRING LINE);
RETURN(SCAN_COORDINATE(LINE, "S", "N"));